home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / ms_dos / happy / calender.pas next >
Pascal/Delphi Source File  |  1993-11-30  |  6KB  |  154 lines
  1. {*****************************************
  2.  *          **** カレンダー ****         *
  3.  *                                       *
  4.  *        HAPPy のサンプルプログラム     *
  5.  *         として作成しました。          *
  6.  *                                       *
  7.  *           Auther  H.Asano             *
  8.  *****************************************}
  9.  
  10. {
  11.    inputから、印字させたい年と月を入力すると、
  12.    その月の前後1ケ月ずつ、合計3ケ月にわたってカレンダーを
  13.    outputに出力します
  14. }
  15.  
  16. program Calender(input,output) ;
  17.  
  18. type
  19.   PrintRange = (before,now,after) ;   { before:前月 now:今月 after:来月}
  20.   YoubiType  = 0..6 ;                 { 日曜日=0  土曜日=6             }
  21.  
  22. var
  23.   Nissu      : array[1..12]      of 1..31     ;  { 月の日数を格納   }
  24.   Year       : array[PrintRange] of integer   ;  { 印字する年を格納 }
  25.   Month      : array[PrintRange] of integer   ;  { 印字する月を格納 }
  26.   FirstYoubi : array[PrintRange] of YoubiType ;  { 1日の曜日        }
  27.  
  28.  
  29. {*****************************************
  30.  *      初期設定 (各月の日数を設定)      *
  31.  *        とりあえず 2月は28日としておく *
  32.  *****************************************}
  33. procedure init ;
  34. begin
  35.   Nissu[ 1{月}] := 31{日} ; Nissu[ 2{月}] := 28{日} ; Nissu[ 3{月}] := 31{日} ;
  36.   Nissu[ 4{月}] := 30{日} ; Nissu[ 5{月}] := 31{日} ; Nissu[ 6{月}] := 30{日} ;
  37.   Nissu[ 7{月}] := 31{日} ; Nissu[ 8{月}] := 31{日} ; Nissu[ 9{月}] := 30{日} ;
  38.   Nissu[10{月}] := 31{日} ; Nissu[11{月}] := 30{日} ; Nissu[12{月}] := 31{日}
  39. end {init} ;
  40.  
  41. {***************************************
  42.  *   y年m月d日の曜日を算出する関数     *
  43.  *     この関数で使っている計算式の    *
  44.  *     意味はよくわかりませんが、      *
  45.  *     汎用関数として使えると思います  *
  46.  ***************************************}
  47. function Youbi(y{年},m{月},d{日}:integer) : YoubiType ;
  48.   var m1,y1 : integer;
  49. begin
  50.   if m >= 3 then
  51.     begin  m1 := m - 2   ; y1 := y      end
  52.   else
  53.     begin  m1 := m  + 10 ; y1 := y - 1  end ;
  54.   Youbi := (y1 + y1 div 4 - y1 div 100 + y1 div 400
  55.                + trunc(2.6*m1 - 0.19) + d    ) mod 7
  56. end {Youbi} ;
  57.  
  58. {*****************************************
  59.  *   year年が閏年の時､真を返す関数       *
  60.  *     4年に一度だが､、100年に一度閏年で *
  61.  *     なく、400年に一度閏年になります   *
  62.  *****************************************}
  63. function Uruu(year:integer) : Boolean ;
  64. begin
  65.   Uruu := (year mod 4 = 0) and (year mod 100 <> 0) or (year mod 400 = 0)
  66. end {Uruu} ;
  67.  
  68. {***************************************
  69.  *   カレンダーの印字処理              *
  70.  ***************************************}
  71. procedure Print ;
  72.   var Day    : array[PrintRange] of integer ;  { 印字する日 }
  73.       Finish : array[PrintRange] of Boolean ;  { 各月の印字が終わったら真 }
  74.       youbi  : YoubiType  ;                    { for文の制御変数 }
  75.       n      : PrintRange ;                    { for文の制御変数 }
  76. begin
  77.   for n := before to after do           { 初期設定 }
  78.   begin
  79.     Finish[n] := false ;
  80.     Day   [n] := 1{日}
  81.   end ;
  82.  
  83.   writeln ;                             { カレンダーの表題 }
  84.   for n := before to after do
  85.     write(' **** ',Year[n]:4,'年', Month[n]:2,'月 ****',' ':5) ;
  86.   writeln ;
  87.   for n := before to after do
  88.     write(' 日 月 火 水 木 金 土',' ':5) ;
  89.   writeln ;
  90.  
  91.   repeat
  92.     for n := before to after do         { 前月､今月､来月の 1行分 }
  93.     begin
  94.       for youbi := 0{日曜} to 6{土曜} do { 各月の1週間分 }
  95.       begin
  96.         if (Day[n] = 1{日}) and (youbi < FirstYoubi[n]) or Finish[n]
  97.           then write(' ':3)
  98.         else                            { 印字していない日の時  }
  99.         begin
  100.           write(Day[n]:3) ;
  101.           Day[n] := Day[n] + 1{日} ;
  102.           Finish[n] :=  Day[n] > Nissu[Month[n]]  { その月の終わりの判定 }
  103.         end
  104.       end {for youbi} ;
  105.       write(' ':5)
  106.     end {for n} ;
  107.     writeln
  108.   until Finish[before] and Finish[now] and Finish[after]
  109.  
  110. end {Print} ;
  111.  
  112. {***************************************
  113.  *            メイン処理               *
  114.  ***************************************}
  115. begin {main}
  116.   init ;                                { 初期設定 }
  117.  
  118.   repeat                                { 印字したい年を入力 }
  119.     write('何年?(西暦2年～9998年まで) ') ;
  120.     readln(Year[now])
  121.   until (2{年} <= Year[now]) and  (Year[now] <= 9998{年}) ;
  122.                      { 2～9998年に深い意味はありません       }
  123.  
  124.   repeat                                { 印字したい月を入力 }
  125.     write('何月?(1月～12月まで) ') ;
  126.     readln(Month[now])
  127.   until (1{月} <= Month[now]) and (Month[now] <= 12{月}) ;
  128.  
  129.   if Uruu(Year[now]) then Nissu[2{月}] := 29{日} ;   { 閏年補正 }
  130.  
  131.                                         { 印字する年､月を求める }
  132.   Month[before] := Month[now]  - 1{年} ;
  133.   Month[after ] := Month[now]  + 1{年} ;
  134.   Year [before] := Year [now] ;
  135.   Year [after ] := Year [now] ;
  136.   if Month[now] = 1{月} then            { 今月が1月の時は、}
  137.   begin                                 { 前月は去年の12月 }
  138.     Month[before] := 12{月} ;
  139.     Year [before] := Year[now] - 1{年}
  140.   end
  141.   else if Month[now] = 12{月} then      { 今月が12月の時は、}
  142.   begin                                 { 来月は来年の1月   }
  143.     Month[after] := 1{月} ;
  144.     Year [after] := Year[now] + 1{年}
  145.   end ;
  146.                                         { 1日の曜日を求める }
  147.   FirstYoubi[before] := Youbi(Year[before], Month[before], 1{日}) ;
  148.   FirstYoubi[now   ] := Youbi(Year[now   ], Month[now   ], 1{日}) ;
  149.   FirstYoubi[after ] := Youbi(Year[after ], Month[after ], 1{日}) ;
  150.  
  151.   Print                                 { 印字する }
  152.  
  153. end {main}.
  154.